home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Internet / FTP / Mirror2.3 / lsparse.pl < prev    next >
Encoding:
Perl Script  |  1994-01-28  |  19.9 KB  |  849 lines
  1. #-*-perl-*-
  2. # Parse "ls -lR" type listings
  3. # use lsparse'reset( dirname ) repeately
  4. # By Lee McLoughlin <lmjm@doc.ic.ac.uk>
  5. #
  6. # $Id: lsparse.pl,v 2.5 1994/01/28 18:00:12 lmjm Exp lmjm $
  7. # $Log: lsparse.pl,v $
  8. # Revision 2.5  1994/01/28  18:00:12  lmjm
  9. # Allow for grasp1.univ-lyon1.fr's D at the start of line for directories.
  10. # Added CTAN parsing.
  11. #
  12. # Revision 2.4  1994/01/26  15:43:00  lmjm
  13. # Added info-mac parser.
  14. # Cleanups to lsparse type lines.
  15. #
  16. # Revision 2.3  1994/01/18  21:58:20  lmjm
  17. # Added F type.
  18. # mode handle 't' type.
  19. # Added line_lsparse.
  20. #
  21. # Revision 2.2  1993/12/14  11:09:08  lmjm
  22. # Parse more unix ls listings.
  23. # Added dosftp parsing.
  24. # Added macos parsing.
  25. #
  26. # Revision 2.1  1993/06/28  15:03:08  lmjm
  27. # Full 2.1 release
  28. #
  29. #
  30.  
  31. # This has better be available via your PERLLIB environment variable
  32. require 'dateconv.pl';
  33.  
  34. package lsparse;
  35.  
  36. # The current directory is stripped off the
  37. # start of the returned pathname
  38. # $match is a pattern that matches this
  39. local( $match );
  40.  
  41. # The filestore type being scanned
  42. $lsparse'fstype = 'unix';
  43.  
  44. # Keep whatever case is on the remote system.  Otherwise lowercase it.
  45. $lsparse'vms_keep_case = '';
  46.  
  47. # A name to report when errors occur
  48. $lsparse'name = 'unknown';
  49.  
  50. # Name of routine to call to parse incoming listing lines
  51. $ls_line = '';
  52.  
  53. # Set the directory that is being scanned and
  54. # check that the scan routing for this fstype exists
  55. # returns false if the fstype is unknown.
  56. sub lsparse'reset
  57. {
  58.     $here = $currdir = @_[0];
  59.     $now = time;
  60.     # Vms tends to give FULL pathnames reguardless of where
  61.     # you generate the dir listing from.
  62.     $vms_strip = $currdir;
  63.     $vms_strip =~ s,^/+,,;
  64.     $vms_strip =~ s,/+$,,;
  65.  
  66.     $ls_line = "lsparse'line_$fstype";
  67.     return( defined( &$ls_line ) );
  68. }
  69.  
  70. # See line_unix following routine for call/return details.
  71. # This calls the filestore specific parser.
  72. sub lsparse'line
  73. {
  74.     # ls_line is setup in lsparse'reset to the name of the function
  75.     local( $path, $size, $time, $type, $mode ) =
  76.         eval "&$ls_line( @_ )";
  77.  
  78.     # Zap any leading ./  (Somehow they still creep thru.)
  79.     $path =~ s:^(\./)+::;
  80.     return ($path, $size, $time, $type, $mode);
  81. }
  82.  
  83. # --------------------- parse standard Unix ls output
  84. # for each file or directory line found return a tuple of
  85. # (pathname, size, time, type, mode)
  86. # pathname is a full pathname relative to the directory set by reset()
  87. # size is the size in bytes (this is always 0 for directories)
  88. # time is a Un*x time value for the file
  89. # type is "f" for a file, "d" for a directory and
  90. #         "l linkname" for a symlink
  91. sub lsparse'line_unix
  92. {
  93.     local( $fh ) = @_;
  94.     local( $non_crud, $perm_denied );
  95.     local( $d );
  96.  
  97.     if( eof( $fh ) ){
  98.         return( "", 0, 0, 0 );
  99.     }
  100.  
  101.     while( <$fh> ){
  102.         # Stomp on carriage returns
  103.         s/\015//g;
  104.  
  105.         # I'm about to look at this at lot
  106.         study;
  107.  
  108.         # Try and spot crud in the line and avoid it
  109.         # You can get:
  110.         # -rw-r--r-ls: navn/internett/RCS/nsc,v: Permission denied
  111.         # ls: navn/internett/RCS/bih,v: Permission denied
  112.         # -  1 43       daemon       1350 Oct 28 14:03 sognhs
  113.         # -rwcannot access .stuff/incoming
  114.         # cannot access .stuff/.cshrc
  115.         if( m%^(.*)/bin/ls:.*Permission denied% ||
  116.            m%^(.*)ls:.*Permission denied% ||
  117.            m%^(.*)(cannot|can not) access % ){
  118.             if( ! $non_crud ){
  119.                 $non_crud = $1;
  120.             }
  121.             next;
  122.         }
  123.         # Also try and spot non ls "Permission denied" messages.  These
  124.         # are a LOT harder to handle as the key part is at the end
  125.         # of the message.  For now just zap any line containing it
  126.         # and the first line following (as it will PROBABLY have been broken).
  127.         #
  128.         if( /.:\s*Permission denied/ ){
  129.             $perm_denied = 1;
  130.             next;
  131.         }
  132.         if( $perm_denied ){
  133.             $perm_denied = "";
  134.             warn "Warning: input corrupted by 'Permission denied'",
  135.                 "errors, about line $. of $lsparse'name\n";
  136.             next;
  137.         }
  138.         # Not found's are like Permission denied's.  They can start part
  139.         # way through a line but with no way of spotting where they begin
  140.         if( /not found/ ){
  141.             $not_found = 1;
  142.             next;
  143.         }
  144.         if( $not_found ){
  145.             $not_found = "";
  146.             warn "Warning: input corrupted by 'not found' errors",
  147.                 " about line $. of $lsparse'name\n";
  148.             next;
  149.         }
  150.         
  151.         if( $non_crud ){
  152.             $_ = $non_crud . $_;
  153.             $non_crud = "";
  154.         }
  155.         
  156.  
  157.         if( /^([\-FlrwxsStTdD]{10}).*\D(\d+)\s*(\w\w\w\s+\d+\s*(\d+:\d+|\d\d\d\d))\s+(.*)\n/ ){
  158.             local( $kind, $size, $lsdate, $file ) = ($1, $2, $3, $5);
  159.             
  160.             if( $file eq '.' || $file eq '..' ){
  161.                 next;
  162.             }
  163.  
  164.             local( $time ) = &main'lstime_to_time( $lsdate );
  165.             local( $type ) = '?';
  166.             local( $mode ) = 0;
  167.  
  168.             # This should be a symlink
  169.             if( $kind =~ /^l/ && $file =~ /(.*) -> (.*)/ ){
  170.                 $file = $1;
  171.                 $type = "l $2";
  172.             }
  173.             elsif( $kind =~ /^[\-F]/ ){
  174.                 # (hopefully) a regular file
  175.                 $type = 'f';
  176.             }
  177.             elsif( $kind =~ /^d/i ){
  178.                 # Don't create private dirs when not
  179.                 # using recurse_hard.
  180.                 if( ! $main'recurse_hard ){
  181.                     next;
  182.                 }
  183.  
  184.                 $type = 'd';    
  185.                 $size = 0;   # Don't believe the report size
  186.             }
  187.             
  188.             $mode = &chars_to_mode( $kind );
  189.  
  190.             $currdir =~ s,/+,/,g;
  191.             $file =~ s,^/$match,,;
  192.             $file = "/$currdir/$file";
  193.             $file =~ s,/+,/,g;
  194.             return( substr( $file, 1 ), $size, $time, $type, $mode );
  195.         }
  196.         # Match starts of directories.  Try not to match
  197.         # directories whose names ending in :
  198.         elsif( /^([\.\/]*.*):$/ && ! /^[dcbsp].*\s.*\s.*:$/ ){
  199.             if( $1 eq '.' ){
  200.                 next;
  201.             }
  202.             elsif( $1 !~ /^\// ){
  203.                 $currdir = "$here/$1";
  204.             }
  205.             else {
  206.                 $currdir = "$1";
  207.             }
  208.             $currdir =~ s,/+,/,g;
  209.             $match = $currdir;
  210.             $match =~ s/([\+\(\)\[\]\*\?])/\\$1/g;
  211.             return( substr( $currdir, 1 ), 0, 0, 'd', 0 );
  212.         }
  213.         elsif( /^[dcbsp].*[^:]$/ || /^\s*$/ || /^[Tt]otal.*/ || /[Uu]nreadable$/ ){
  214.             ;
  215.         }
  216.         elsif( /^.*[Uu]pdated.*:/ ){
  217.             # Probably some line like:
  218.             # Last Updated:  Tue Oct  8 04:30:50 EDT 1991
  219.             # skip it
  220.             next;
  221.         }
  222.         elsif( /^([\.\/]*[^\s]*)/ ){
  223.             # Just for the export.lcs.mit.edu ls listing
  224.             $match = $currdir = "$1/";
  225.             $match =~ s/[\+\(\[\*\?]/\\$1/g;
  226.         }        
  227.         else {
  228.             printf( "Unmatched line: %s", $_ );
  229.         }
  230.     }
  231.     return( '', 0, 0, 0, 0 );
  232. }
  233.  
  234. # Convert the mode chars at the start of an ls-l entry into a number
  235. sub chars_to_mode
  236. {
  237.     local( $chars ) = @_;
  238.     local( @kind, $c );
  239.  
  240.     # Split and remove first char
  241.     @kind = split( //, $kind );
  242.     shift( @kind );
  243.  
  244.     foreach $c ( @kind ){
  245.         $mode <<= 1;
  246.         if( $c ne '-' && $c ne 'S' && $c ne 't' && $c ne 'T' ){
  247.             $mode |= 1;
  248.         }
  249.     }
  250.  
  251.     # check for "special" bits
  252.  
  253.     # uid bit
  254.     if( /^...s....../i ){
  255.         $mode |= 04000;
  256.     }
  257.  
  258.     # gid bit
  259.     if( /^......s.../i ){
  260.         $mode |= 02000;
  261.     }
  262.  
  263.     # sticky bit
  264.     if( /^.........t/i ){
  265.         $mode |= 01000;
  266.     }
  267.  
  268.     return $mode;
  269. }
  270.  
  271. # --------------------- parse dls output
  272.  
  273. # dls is a descriptive ls that some sites use.
  274. # this parses the output of dls -dtR
  275.  
  276. # for each file or directory line found return a tuple of
  277. # (pathname, size, time, type, mode)
  278. # pathname is a full pathname relative to the directory set by reset()
  279. # size is the size in bytes (this is always 0 for directories)
  280. # time is a Un*x time value for the file
  281. # type is "f" for a file, "d" for a directory and
  282. #         "l linkname" for a symlink
  283. sub lsparse'line_dls
  284. {
  285.     local( $fh ) = @_;
  286.     local( $non_crud, $perm_denied );
  287.  
  288.     if( eof( $fh ) ){
  289.         return( "", 0, 0, 0 );
  290.     }
  291.  
  292.     while( <$fh> ){
  293.         # Stomp on carriage returns
  294.         s/\015//g;
  295.  
  296.         # I'm about to look at this at lot
  297.         study;
  298.  
  299.         if( /^(\S*)\s+(\-|\=|\d+)\s+((\w\w\w\s+\d+|\d+\s+\w\w\w)\s+(\d+:\d+|\d\d\d\d))\s+(.+)\n/ ){
  300.             local( $file, $size, $lsdate, $description ) =
  301.                 ($1, $2, $3, $6);
  302.             $file =~ s/\s+$//;
  303.             local( $time, $type, $mode );
  304.             
  305.             if( $file =~ m|/$| ){
  306.                 # a directory
  307.                 $file =~ s,/$,,;
  308.                 $time = 0;
  309.                 $type = 'd';
  310.                 $mode = 0555;
  311.             }
  312.             else {
  313.                 # a file
  314.                 $time = &main'lstime_to_time( $lsdate );
  315.                 $type = 'f';
  316.                 $mode = 0444;
  317.             }
  318.  
  319.             # Handle wrapped long filenames
  320.             if( $filename ne '' ){
  321.                 $file = $filename;
  322.             }
  323.             $filename = '';
  324.  
  325.             $file =~ s/\s*$//;
  326.             $file = "$currdir/$file";
  327.             $file =~ s,/+,/,g;
  328.             return( substr( $file, 1 ), $size, $time, $type, $mode );
  329.         }
  330.         elsif( /^(.*):$/ ){
  331.             if( $1 eq '.' ){
  332.                 next;
  333.             }
  334.             elsif( $1 !~ /^\// ){
  335.                 $currdir = "$here/$1/";
  336.             }
  337.             else {
  338.                 $currdir = "$1/";
  339.             }
  340.             $filename = '';
  341.             $currdir =~ s,/+,/,g;
  342.             $match = $currdir;
  343.             $match =~ s/([\+\(\)\[\]\*\?])/\\$1/g;
  344.             return( substr( $currdir, 1 ), 0, 0, 'd', 0 );
  345.         }
  346.         else {
  347.             # If a filename is long then it is on a line by itself
  348.             # with the details on the next line
  349.             chop( $filename = $_ );
  350.         }
  351.     }
  352.     return( '', 0, 0, 0, 0 );
  353. }
  354.  
  355. # --------------------- parse netware output
  356.  
  357. # For each file or directory line found return a tuple of
  358. # (pathname, size, time, type, mode)
  359. # pathname is a full pathname relative to the directory set by reset()
  360. # size is the size in bytes (this is always 0 for directories)
  361. # time is a Un*x time value for the file
  362. # type is "f" for a file, "d" for a directory and
  363. #         "l linkname" for a symlink
  364. sub lsparse'line_netware
  365. {
  366.     local( $fh ) = @_;
  367.  
  368.     if( eof( $fh ) ){
  369.         return( "", 0, 0, 0 );
  370.     }
  371.  
  372.     while( <$fh> ){
  373.         # Stomp on carriage returns
  374.         s/\015//g;
  375. # Unix vs NetWare:
  376. #1234567890 __________.*_____________ d+  www dd  dddd (.*)\n
  377. #drwxr-xr-x   2 jrd      other        512 Feb 29  1992 vt100
  378. #   kind                       size lsdate       file
  379. #123456789012sw+ ____.*_______\s+(\d+)   \s+  wwwsddsdd:dd\s+ (.*)\n  
  380. #- [R----F--] jrd                197928       Sep 25 15:19    kermit.exe
  381. #d [R----F--] jrd                   512       Oct 06 09:31    source
  382. #d [RWCEAFMS] jrd                   512       Sep 04 14:38    lwp
  383.  
  384.         if( /^([d|l|\-]\s\[[RWCEAFMS\-]{8}\])\s\w+\s+(\d+)\s*(\w\w\w\s+\d+\s*(\d+:\d+|\d\d\d\d))\s+(.*)\n/) {
  385.             local( $kind, $size, $lsdate, $file ) =
  386.                          ( $1, $2, $3, $5);
  387.             if( $file eq '.' || $file eq '..' ){
  388.                 next;
  389.             }
  390.             local( $time ) = &main'lstime_to_time( $lsdate );
  391.             local( $type ) = '?';
  392.             local( $mode ) = 0;
  393.  
  394.             # This should be a symlink
  395.             if( $kind =~ /^l/ && $file =~ /(.*) -> (.*)/ ){
  396.                 $file = $1;
  397.                 $type = "l $2";
  398.             }
  399.             elsif( $kind =~ /^-/ ){
  400.                 # (hopefully) a regular file
  401.                 $type = 'f';
  402.             }
  403.             
  404.             $mode = &netware_to_mode( $kind );
  405.  
  406.             if( $kind =~ /^d/ ) {
  407.                 # a directory
  408.                 $type = 'd';
  409.                 $size = 0;   # Don't believe the report size
  410.             }
  411.             $currdir =~ s,/+,/,g;
  412.             $file =~ s,^/$match,,;
  413.             $file = "/$currdir/$file";
  414.             $file =~ s,/+,/,g;
  415.             return( substr( $file, 1 ), $size, $time, $type, $mode );
  416.         }
  417.  
  418.         elsif( /^[dcbsp].*[^:]$/ || /^\s*$/ || /^[Tt]otal.*/ || /[Uu]nreadable$/ ){
  419.             ;
  420.         }
  421.         elsif( /^.*[Uu]pdated.*:/ ){
  422.             # Probably some line like:
  423.             # Last Updated:  Tue Oct  8 04:30:50 EDT 1991
  424.             # skip it
  425.             next;
  426.         }
  427.         else {
  428.             printf( "Unmatched line: %s", $_ );
  429.             return( '', 0, 0, 0, 0 );
  430.         }
  431.     }
  432.     return( '', 0, 0, 0, 0 );
  433. }
  434.  
  435. # Convert NetWare file access mode chars at the start of a DIR entry 
  436. # into a Unix access number.
  437. sub netware_to_mode
  438. {
  439.     local( $chars ) = @_;
  440.     local( @kind, $c );
  441.  
  442.     # Split and remove first three characters
  443.     @kind = split( //, $kind );
  444.     shift( @kind );        # omit directory "d" field
  445.     shift( @kind );        # omit space separator
  446.     shift( @kind );        # omit left square bracket
  447.     $mode = 0;        # init $mode to no access
  448.  
  449.     foreach $c ( @kind ){
  450.         if( $c eq 'R' )    {$mode |= 0x644;}    ## r/w r r
  451.         if( $c eq 'W' ) {$mode |= 0x222;}    ## w   w w
  452.         if( $c eq 'F' ) {$mode |= 0x444;}    ## r   r r
  453.         }
  454.     return $mode;
  455. }
  456. # --------------------- parse VMS dir output
  457. # for each file or directory line found return a tuple of
  458. # (pathname, size, time, type, mode)
  459. # pathname is a full pathname relative to the directory set by reset()
  460. # size is the size in bytes (this is always 0 for directories)
  461. # time is a Un*x time value for the file
  462. # type is "f" for a file, "d" for a directory and
  463. #         "l linkname" for a symlink
  464. sub lsparse'line_vms
  465. {
  466.     local( $fh ) = @_;
  467.     local( $non_crud, $perm_denied );
  468.  
  469.     if( eof( $fh ) ){
  470.         return( "", 0, 0, 0 );
  471.     }
  472.  
  473.     while( <$fh> ){
  474.         # Stomp on carriage returns
  475.         s/\015//g;
  476.  
  477.         # I'm about to look at this at lot
  478.         study;
  479.  
  480.         if( /^\s*$/ ){
  481.             next;
  482.         }
  483.  
  484.         if( /^\s*Total of/i ){
  485.             # Just a size report ignore
  486.             next;
  487.         }
  488.  
  489.         if( /\%RMS-E-PRV|insufficient privilege/i ){
  490.             # A permissions error - skip the line
  491.             next;
  492.         }
  493.  
  494.         # Upper case is so ugly
  495.         if( ! $lsparse'vms_keep_case ){
  496.             tr/A-Z/a-z/;
  497.         }
  498.  
  499.         # DISK$ANON:[ANONYMOUS.UNIX]
  500.         if( /^([^:]+):\[([^\]+]+)\]\s*$/ ){
  501.             # The directory name
  502.             # Use the Unix convention of /'s in filenames not
  503.             # .'s
  504.             $currdir = '/' . $2;
  505.             $currdir =~ s,\.,/,g;
  506.             $currdir =~ s,/+,/,g;
  507.             $currdir =~ s,^/$vms_strip,,;
  508.             if( $currdir eq '' ){
  509.                 next;
  510.             }
  511.             $match = $currdir;
  512.             $match =~ s/([\+\(\)\[\]\*\?])/\\$1/g;
  513. #print ">>>match=$match currdir=$currdir\n";
  514.             return( substr( $currdir, 1 ), 0, 0, 'd', 0 );
  515.         }
  516.         
  517.     # MultiNet FTP
  518.     # DSPD.MAN;1  9   1-APR-1991 12:55 [SG,ROSENBLUM] (RWED,RWED,RE,RE)
  519.     # CMU/VMS-IP FTP
  520.     # [VMSSERV.FILES]ALARM.DIR;1      1/3          5-MAR-1993 18:09
  521.         local( $dir, $file, $vers, $size, $lsdate, $got );
  522.         $got = 0;
  523.         # For now ignore user and mode
  524.         if( /^((\S+);(\d+))?\s+(\d+)\s+(\d+-\S+-\d+\s+\d+:\d+)/ ){
  525.             ($file, $vers, $size, $lsdate) = ($2,$3,$4,$5);
  526.             $got = 1;
  527.         }
  528.         elsif( /^(\[([^\]]+)\](\S+);(\d+))?\s+\d+\/\d+\s+(\d+-\S+-\d+\s+\d+:\d+)\s*$/ ){
  529.             ($dir,$file,$vers,$lsdate) = ($2,$3,$4,$5);
  530.             $got = 1;
  531.         }
  532.         # The sizes mean nothing under unix...
  533.         $size = 0;
  534.         
  535.         if( $got ){
  536.             local( $time ) = &main'lstime_to_time( $lsdate );
  537.             local( $type ) = 'f';
  538.             local( $mode ) = 0444;
  539.  
  540.             # Handle wrapped long filenames
  541.             if( $filename ne '' ){
  542.                 $file = $filename;
  543.                 $vers = $version;
  544.                 if( $directory ){
  545.                     $dir = $directory;
  546.                 }
  547.             }
  548.             if( defined( $dir ) ){
  549.                 $dir =~ s/\./\//g;
  550.                 $file = $dir . '/' . $file;
  551.             }
  552.             $filename = '';
  553.  
  554.             if( $file =~ /^(.*)\.dir(;\d+)?$/ ){
  555.                 if( ! $vms_keep_dotdir ){
  556.                     $file = $1 . $2;
  557.                 }
  558.                 $type = 'd';
  559.                 $mode = 0555;
  560.             }
  561.  
  562.             $lsparse'vers = $vers;
  563.  
  564. #print "file=|$file| match=|$match| vms_strip=|$vms_strip|\n";
  565.             $file =~ s,^,/,;
  566.             $file =~ s,^/$match,,;
  567.             if( ! defined( $dir ) ){
  568.                 $file = "$currdir/$file";
  569.             }
  570.             $file =~ s,^$vms_strip,,;
  571.             $file =~ s,/+,/,g;
  572. #print  "file=|$file|\n";
  573.             return( substr( $file, 1 ), $size, $time, $type, $mode );
  574.         }
  575.         elsif( /^\[([^\]]+)\](\S+);(\d+)\s*$/ ){
  576.             # If a filename is long then it is on a line by itself
  577.             # with the details on the next line
  578.             local( $d, $f, $v ) = ($1, $2, $3);
  579.             $d =~ s/\./\//g;
  580.             $directory = $d;
  581.             $filename = $f;
  582.             $version = $v;
  583.         }
  584.         elsif( /^(\S+);(\d+)\s*$/ ){
  585.             # If a filename is long then it is on a line by itself
  586.             # with the details on the next line
  587.             $filename = $1;
  588.             $version = $2;
  589.         }
  590.         else {
  591.             printf( "Unmatched line: %s", $_ );
  592.         }
  593.     }
  594.     return( '', 0, 0, 0, 0 );
  595. }
  596.  
  597. # --------------------- parse output from dos ftp server
  598. # for each file or directory line found return a tuple of
  599. # (pathname, size, time, type, mode)
  600. # pathname is a full pathname relative to the directory set by reset()
  601. # size is the size in bytes (this is always 0 for directories)
  602. # time is a Un*x time value for the file
  603. # type is "f" for a file, "d" for a directory and
  604. #         "l linkname" for a symlink
  605. sub lsparse'line_dosftp
  606. {
  607.     local( $fh ) = @_;
  608.  
  609.     while( 1 ){
  610.         if( $pending ){
  611.             $_ = $pending;
  612.             $pending = '';
  613.         }
  614.         else {
  615.             if( eof( $fh ) ){
  616.                 return( "", 0, 0, 0 );
  617.             }
  618.  
  619.             $_ = <$fh>;
  620.             # Ignore the summary at the end and blank lines
  621.             if( /^\d+ files?\./ || /^\s+$/ ){
  622.                 next;
  623.             }
  624.         }
  625.  
  626.         # Stomp on carriage returns
  627.         s/\015//g;
  628.  
  629.         # I'm about to look at this at lot
  630.         study;
  631.  
  632.         if( m|(\S+)\s+(\S+)?\s+(\d+):(\d+)\s+(\d+)/(\d+)/(\d+)\s*(.*)| ){
  633.             local( $file, $commasize, $hrs, $min, $mon, $day, $yr ) =
  634.                 ($1, $2, $3, $4, $5, $6, $7);
  635.             $pending = $8;
  636.  
  637.             # TODO: fix hacky 19$yr
  638.             local( $lsdate ) = "$day-$mon-19$yr $hrs:$min";
  639.             local( $time ) = &main'lstime_to_time( $lsdate );
  640.             local( $type ) = '?';
  641.             local( $mode ) = 0;
  642.  
  643.             local( $size ) = $commasize;
  644.             $size =~ s/,//g;
  645.  
  646.             if( $file =~ m:(.*)/$: ){
  647.                 $file = $1;
  648.                 $type = 'd';    
  649.                 $size = 0;   # Don't believe the report size
  650.             }
  651.             else {
  652.                 # (hopefully) a regular file
  653.                 $type = 'f';
  654.             }
  655.             
  656.             $currdir =~ s,/+,/,g;
  657.             $file =~ s,^/$match,,;
  658.             $file = "/$currdir/$file";
  659.             $file =~ s,/+,/,g;
  660.             return( substr( $file, 1 ), $size, $time, $type, $mode );
  661.         }
  662.         else {
  663.             printf( "Unmatched line: %s", $_ );
  664.         }
  665.     }
  666.     return( '', 0, 0, 0, 0 );
  667. }
  668.  
  669.  
  670. # --------------------- parse standard MACOS Unix-like ls output
  671. # for each file or directory line found return a tuple of
  672. # (pathname, size, time, type, mode)
  673. # pathname is a full pathname relative to the directory set by reset()
  674. # size is the size in bytes (this is always 0 for directories)
  675. # time is a Un*x time value for the file
  676. # type is "f" for a file, "d" for a directory and
  677. #         "l linkname" for a symlink
  678. sub lsparse'line_macos
  679. {
  680.     local( $fh ) = @_;
  681.     local( $non_crud, $perm_denied );
  682.  
  683.     if( eof( $fh ) ){
  684.         return( "", 0, 0, 0 );
  685.     }
  686.  
  687.     while( <$fh> ){
  688.         # Stomp on carriage returns
  689.         s/\015//g;
  690.  
  691.         # I'm about to look at this at lot
  692.         study;
  693.  
  694.         if( /^([\-rwxd]{10}).*\s(\d+\s+)?(\S+)\s+\d+\s*(\w\w\w\s+\d+\s*(\d+:\d+|\d\d\d\d))\s+(.*)\n/ ){
  695.             local( $kind, $size, $lsdate, $file ) = ($1, $3, $4, $6);
  696.             
  697.             local( $time ) = &main'lstime_to_time( $lsdate );
  698.             local( $type ) = '?';
  699.             local( $mode ) = 0;
  700.  
  701.             if( $kind =~ /^-/ ){
  702.                 # (hopefully) a regular file
  703.                 $type = 'f';
  704.             }
  705.             elsif( $kind =~ /^d/ ){
  706.                 $type = 'd';    
  707.                 $size = 0;   # Don't believe the report size
  708.             }
  709.             
  710.             $currdir =~ s,/+,/,g;
  711.             $file =~ s,^/$match,,;
  712.             $file = "/$currdir/$file";
  713.             $file =~ s,/+,/,g;
  714.             return( substr( $file, 1 ), $size, $time, $type, $mode );
  715.         }
  716.         else {
  717.             printf( "Unmatched line: %s", $_ );
  718.         }
  719.     }
  720.     return( '', 0, 0, 0, 0 );
  721. }
  722.  
  723.  
  724. # --------------------- parse lsparse log file format
  725. # lsparse'line_lsparse() is for input in lsparse's internal form,
  726. # as it might have been written to a log file during a previous
  727. # run of a program that uses lsparse.  The format is:
  728. #     filename size time type mode
  729. # where size and time are in decimal, mode is in decimal or octal,
  730. # and type is one or two words.
  731. sub lsparse'line_lsparse
  732. {
  733.     local( $fh ) = @_;
  734.  
  735.     if( $lsparse'readtime ){
  736.         alarm( $lsparse'readtime );
  737.     }
  738.  
  739.     if( eof( $fh ) ){
  740.         alarm( 0 );
  741.         return( "", 0, 0, 0 );
  742.     }
  743.  
  744.     while( <$fh> ){
  745.         if( /^(\S+)\s+(\d+)\s+(\d+)\s+((l\s+)?\S+)\s+(\d+)\n$/ ){
  746.             # looks good.
  747.             # note that $type is two words iff it starts with 'l'
  748.             local( $name, $size, $time, $type, $mode )
  749.                 = ( $1, $2, $3, $4, $6 );
  750.             
  751.             $mode = oct($mode) if $mode =~ /^0/;
  752.             return( $name, $size, $time, $type, $mode );
  753.         }
  754.         else {
  755.             printf( "Unmatched line: %s\n", $_ );
  756.         }
  757.     }
  758.     alarm( 0 );
  759.     return( '', 0, 0, 0, 0 );
  760. }
  761.  
  762.  
  763. # --------------------- Info-Mac all-files
  764. # -r     1974 Jul 21 00:06 00readme.txt
  765. # lr        3 Sep  8 08:34 AntiVirus -> vir
  766. # ...
  767. # This is the format used at sumex-aim.stanford.edu for the info-mac area.
  768. # (see info-mac/help/all-files.txt.gz).
  769. #
  770. sub lsparse'line_infomac
  771. {
  772.     local( $fh ) = @_;
  773.  
  774.     if( $lsparse'readtime ){
  775.         alarm( $lsparse'readtime );
  776.     }
  777.  
  778.     if( eof( $fh ) ){
  779.         alarm( 0 );
  780.         return( "", 0, 0, 0 );
  781.     }
  782.  
  783.     while( <$fh> ){
  784.         next if /^;/;
  785.         if( /^([l-].)\s*(\d+)\s*(\w\w\w\s+\d+\s*(\d+:\d+|\d\d\d\d))\s+(.*)\n/ ){
  786.             local( $kind, $size, $lsdate, $file ) = ($1, $2, $3, $5);
  787.             
  788.             local( $time ) = &main'lstime_to_time( $lsdate );
  789.  
  790.             # This should be a symlink
  791.             if( $kind =~ /^l/ && $file =~ /(.*) -> (.*)/ ){
  792.                 $file = $1;
  793.                 $type = "l $2";
  794.             }
  795.             elsif( $kind =~ /^[\-F]/ ){
  796.                 # (hopefully) a regular file
  797.                 $type = 'f';
  798.             }
  799.             else {
  800.                 printf( "Unparsable info-mac line: %s\n", $_ );
  801.                 next;
  802.             }
  803.             
  804.             return( $file, $size, $time, $type, 0444 );
  805.         }
  806.         else {
  807.             printf( "Unmatched line: %s\n", $_ );
  808.         }
  809.     }
  810.     alarm( 0 );
  811.     return( '', 0, 0, 0, 0 );
  812. }
  813.  
  814.  
  815. # --------------------- CTAN files list
  816. #    22670 Mon Jul 20 12:36:34 1992 pub/tex/biblio/bibtex/contrib/aaai-named.bst
  817. #
  818. sub lsparse'line_ctan
  819. {
  820.     local( $fh ) = @_;
  821.  
  822.     if( $lsparse'readtime ){
  823.         alarm( $lsparse'readtime );
  824.     }
  825.  
  826.     if( eof( $fh ) ){
  827.         alarm( 0 );
  828.         return( "", 0, 0, 0 );
  829.     }
  830.  
  831.     while( <$fh> ){
  832.         if( /^\s*(\d+)\s+(\w\w\w\s+\w\w\w\s+\d+\s+\d+:\d+:\d+\s+\d+)\s+(.*)\n/ ){
  833.             local( $size, $lsdate, $file ) = ($1, $2, $3);
  834.             
  835.             local( $time ) = &main'lstime_to_time( $lsdate );
  836.  
  837.             return( $file, $size, $time, 'f', 0444 );
  838.         }
  839.         else {
  840.             printf( "Unmatched line: %s\n", $_ );
  841.         }
  842.     }
  843.     alarm( 0 );
  844.     return( '', 0, 0, 0, 0 );
  845. }
  846.  
  847. # -----
  848. 1;
  849.